home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog7.arj / PGRAPH.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  3.9 KB  |  167 lines
  1. { pgraph.pas -- Print graphics }
  2.  
  3. program PGraph;
  4.  
  5. {$R pgraph.res}
  6.  
  7. uses WinTypes, WinProcs, WObjects, UPrint;
  8.  
  9. const
  10.  
  11.   id_Menu   = 100;   { Menu resource ID }
  12.   cm_New    = 101;   { Menu:New command ID }
  13.   cm_Print  = 102;   { Menu:Print command ID }
  14.   cm_Quit   = 103;   { Menu:Exit command ID }
  15.   numShapes = 10;    { Number of ellipses, rectangles, and lines }
  16.  
  17. type
  18.  
  19.   ShapeArray = array[1 .. numShapes] of TRect;
  20.  
  21.   PGraphApplication = object(TApplication)
  22.     procedure InitMainWindow; virtual;
  23.   end;
  24.  
  25.   PPGraphWindow = ^PGraphWindow;
  26.   PGraphWindow = object(TWindow)
  27.     ClientWidth, ClientHeight: Word;
  28.     Ellipses, Rectangles, Lines: ShapeArray;
  29.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  30.     procedure SetupWindow; virtual;
  31.     procedure MakeRandShapes(var Shapes: ShapeArray);
  32.     procedure MakeShapes;
  33.     procedure DrawShapes(DC: HDC);
  34.     procedure Paint(PaintDC: HDC;
  35.       var PaintInfo: TPaintStruct); virtual;
  36.     procedure CMNew(var Msg: TMessage);
  37.       virtual cm_First + cm_New;
  38.     procedure CMPrint(var Msg: TMessage);
  39.       virtual cm_First + cm_Print;
  40.     procedure CMQuit(var Msg: TMessage);
  41.       virtual cm_First + cm_Quit;
  42.   end;
  43.  
  44.  
  45. { PGraphApplication }
  46.  
  47. {- Initialize PGraphApplication object's window }
  48. procedure PGraphApplication.InitMainWindow;
  49. begin
  50.   MainWindow := New(PPGraphWindow, Init(nil, 'PGraph'))
  51. end;
  52.  
  53.  
  54. { PGraphWindow }
  55.  
  56. {- Construct PGraphWindow object }
  57. constructor PGraphWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  58. begin
  59.   TWindow.Init(AParent, ATitle);
  60.   with Attr do
  61.   begin
  62.     X := 10; Y := 10; W := 500; H := 300;
  63.     Menu := LoadMenu(HInstance, PChar(id_Menu))
  64.   end
  65. end;
  66.  
  67. {- Prepare window contents. }
  68. procedure PGraphWindow.SetupWindow;
  69. begin
  70.   TWindow.SetupWindow;
  71.   MakeShapes
  72. end;
  73.  
  74. {- Fill Shapes array with random values }
  75. procedure PGraphWindow.MakeRandShapes(var Shapes: ShapeArray);
  76. var
  77.   I: Integer;
  78.   R: TRect;
  79. begin
  80.   GetClientRect(HWindow, R);
  81.   ClientWidth := R.Right;
  82.   ClientHeight := R.Bottom;
  83.   for I := 1 to numShapes do
  84.   with Shapes[I] do
  85.   begin
  86.     Left := Random(ClientWidth div 2);
  87.     Top := Random(ClientHeight div 2);
  88.     Right := Left + Random(ClientWidth - Left);
  89.     Bottom := Top + Random(ClientHeight - Top)
  90.   end
  91. end;
  92.  
  93. {- Create a few shapes at random }
  94. procedure PGraphWindow.MakeShapes;
  95. begin
  96.   MakeRandShapes(Ellipses);
  97.   MakeRandShapes(Rectangles);
  98.   MakeRandShapes(Lines)
  99. end;
  100.  
  101. {- Draw shapes into device context (display or printer) }
  102. procedure PGraphWindow.DrawShapes(DC: HDC);
  103. var
  104.   I: Integer;
  105. begin
  106.   for I := 1 to numShapes do
  107.   begin
  108.     with Ellipses[I] do
  109.       Ellipse(DC, Left, Top, Right, Bottom);
  110.     with Rectangles[I] do
  111.       Rectangle(DC, Left, Top, Right, Bottom);
  112.     with Lines[I] do
  113.     begin
  114.       MoveTo(DC, Left, Top);
  115.       LineTo(DC, Right, Bottom)
  116.     end
  117.   end
  118. end;
  119.  
  120. {- Paint shapes inside window }
  121. procedure PGraphWindow.Paint(PaintDC: HDC;
  122.   var PaintInfo: TPaintStruct);
  123. begin
  124.   TWindow.Paint(PaintDC, PaintInfo);
  125.   DrawShapes(PaintDC)
  126. end;
  127.  
  128. {- Execute Menu:New shapes command }
  129. procedure PGraphWindow.CMNew(var Msg: TMessage);
  130. begin
  131.   MakeShapes;
  132.   InvalidateRect(HWindow, nil, true)
  133. end;
  134.  
  135. {- Execute Menu:Print shapes command }
  136. procedure PGraphWindow.CMPrint(var Msg: TMessage);
  137. begin
  138.   if PrnStart('PGraph') then
  139.   begin
  140.     DrawShapes(PDc);
  141.     NewPage;
  142.     PrnStop
  143.   end
  144. end;
  145.  
  146. {- Execute Menu:Exit command }
  147. procedure PGraphWindow.CMQuit(var Msg: TMessage);
  148. begin
  149.   CloseWindow
  150. end;
  151.  
  152. var
  153.  
  154.   PGraphApp: PGraphApplication;
  155.  
  156. begin
  157.   PGraphApp.Init('PGraphApp');
  158.   PGraphApp.Run;
  159.   PGraphApp.Done
  160. end.
  161.  
  162.  
  163. {--------------------------------------------------------------
  164.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  165.   Revision 1.00    Date: 5/17/1991
  166. ---------------------------------------------------------------}
  167.